home *** CD-ROM | disk | FTP | other *** search
/ Suzy B Software 2 / Suzy B Software CD-ROM 2 (1994).iso / nasa / solunecl / solunecl.bas < prev    next >
Encoding:
BASIC Source File  |  1995-05-02  |  7.7 KB  |  227 lines
  1. 190 DEF FN LESS(X)=((X/360)-FIX(X/360))*360
  2. 200 DIM TI%(14),UR(5),SD(5)
  3. 220 RA=.0174532925#
  4. 230 PRINT "                  SOLAR AND LUNAR ECLIPSE CALCULATION PROGRAM":PRINT
  5. 231 PRINT "                     FROM THE NOV., 1986 ASTRONOMY MAGAZINE":PRINT:PRINT
  6. 232 PRINT "THIS PROGRAM WILL PREDICT SOLAR AND LUNAR ECLIPSES FROM THE YEAR 1900 THROUGH"
  7. 233 PRINT "9999.  THE PROGRAM WILL ASK FOR FIVE INPUTS: THE YEAR, MONTH, AND DAY TO START"
  8. 234 PRINT "THE PREDICTIONS FROM, WHETHER YOU WISH FOR <S>OLAR OR <L>UNAR ECLIPSES, AND"
  9. 235 PRINT "WHETHER TO CALCULATE <F>ORWARD OR <B>ACKWARD IN TIME FROM THE STARTING DATE.":PRINT
  10. 237 PRINT "THE PROGRAM WILL SHOW THE CLOSEST EVENT HAPENING TO THE DATE ENTERED, THEN ASK"
  11. 238 PRINT "WHETHER TO <C>ONTINUE, <E>ND, OR SHOW <M>ENU.  IF <C>ONTINUE IS SELECTED, THE"
  12. 239 PRINT "PROGRAM WILL SHOW THE NEXT EVENT IN THE TIME DIRECTION SELECTED.  IF <E>ND IS"
  13. 240 PRINT "SELECTED, THE PROGRAM WILL TERMINATE.  IF <M>ENU IS SELECTED, THE PROGRAM WILL"
  14. 241 PRINT "START OVER AND ASK FOR THE YEAR AGAIN.  THIS WILL ALOW A SWITCH TO THE TYPE OF"
  15. 242 PRINT "ECLIPSE OR A CHANGE IN TIME DIRECTION.":PRINT:PRINT
  16. 243 INPUT "DO YOU WISH TO COMPUTE (Y/N)";Q$
  17. 244 IF Q$="Y" OR Q$="y" THEN CLS:GOTO 250
  18. 245 IF Q$="N" OR Q$="n" THEN END
  19. 250 CLS:GOSUB 2360
  20. 270 GOSUB 2550
  21. 280 Y2=Y%+(D0%/365)
  22. 300 K=(Y2-1900)*12.3685
  23. 310 K3=ABS(K-FIX(K))
  24. 320 IF K<0 THEN K3=K3+1
  25. 340 IF (K3>.5) AND (LS$="S") THEN K=K+.5*SGN(K)
  26. 370 IF LS$="L" THEN K2=.5 ELSE K2=0
  27. 380 K=FIX(K)+K2*SGN(K)
  28. 390 T=K/1236.85
  29. 420 SM=359.2242#+29.10535608000003#*K-.0000333*T^2-3.47E-06*T^3
  30. 430 SM=FN LESS(SM)
  31. 440 SM=SM*RA
  32. 450 MM=306.0253#+385.81691806#*K+.0107306*T^2+1.236E-05*T^3
  33. 460 MM=FN LESS(MM)
  34. 470 MM=MM*RA
  35. 480 FM=21.2964+390.67050646#*K-.0016528*T^2-2.39E-06*T^3
  36. 490 FM=FN LESS(FM)
  37. 500 FM=FM*RA
  38. 540 JD=.75933+.53058868#*K+.0001178*T^2-1.55E-07*T^3
  39. 550 JD=JD+.00033*SIN((166.56+132.87*T-.009173*T^2)*RA)
  40. 570 IF LS$="L" THEN JD=JD+.5
  41. 580 JW=FIX(2.41502E+06+29*K)
  42. 600 MX=(.1734-.000393*T)*SIN(SM)+.0021*SIN(2*SM)
  43. 610 MX=MX-.4068*SIN(MM)+.0161*SIN(2*MM)
  44. 620 MX=MX-.0051*SIN(SM+MM)-.0074*SIN(SM-MM)
  45. 630 MX=MX-.0104*SIN(2*FM)
  46. 640 JD=JD+MX
  47. 650 JW=JW+FIX(JD)
  48. 660 JD=JD-FIX(JD)
  49. 680 GOSUB 2670
  50. 700 TE=ABS(SIN(FM))
  51. 720 IF TE>.36 THEN GOSUB 2300 ELSE 770
  52. 730 K=K+BF
  53. 740 GOTO 390
  54. 770 S1=5.19595-.0048*COS(SM)+.002*COS(2*SM)
  55. 780 S1=S1-.3283*COS(MM)-.006*COS(SM+MM)
  56. 790 S1=S1+.0041*COS(SM+MM)
  57. 800 C1=.207*SIN(SM)+.0024*SIN(2*SM)-.039*SIN(MM)
  58. 810 C1=C1+.0115*SIN(2*MM)-.0073*SIN(SM+MM)
  59. 820 C1=C1-.0067*SIN(SM-MM)+.0117*SIN(2*FM)
  60. 840 GY=S1*SIN(FM)+C1*COS(FM)
  61. 850 G1=ABS(GY)
  62. 870 MU=.0059+.0046*COS(SM)-.0182*COS(MM)
  63. 880 MU=MU+.0004*COS(2*MM)-.0005*COS(SM+MM)
  64. 910 NT=.5458+.04*COS(MM)
  65. 920 UR(0)=1.5572+MU:UR(1)=1.0129-MU:UR(2)=.4679-MU
  66. 930 UR(3)=1.572+MU:UR(4)=1.026-MU
  67. 960 MG=(1.5432+MU-G1)/(.546+2*MU)
  68. 970 PM=(1.5572+MU-G1)/.545
  69. 980 UM=(1.0129-MU-G1)/.545
  70. 1000 ND=COS(FM)
  71. 1010 IF ND<0 THEN ND$="DESCENDING" ELSE ND$="ASCENDING"
  72. 1030 IF GY<0 THEN NS$="SOUTH" ELSE NS$="NORTH"
  73. 1050 IF (LS$="L") AND (PM>=0) THEN GOSUB 1580 ELSE 1090
  74. 1060 GOSUB 1960
  75. 1070 GOTO 1230
  76. 1090 IF (LS$="L") AND (PM<0) THEN GOSUB 2300:GOTO 1310
  77. 1120 IF G1>1.5432+MU THEN GOSUB 2300:GOTO 1310
  78. 1140 IF G1<.9972 THEN II%=0 ELSE 1190
  79. 1150 GOSUB 1350
  80. 1160 GOSUB 1960
  81. 1170 GOTO 1230
  82. 1190 T2=1.5432+MU
  83. 1200 IF (G1>.9972) AND (G1<T2) THEN II%=1 ELSE 1320
  84. 1210 GOSUB 1470
  85. 1220 GOSUB 1960
  86. 1230 PRINT
  87. 1240 INPUT "<C>ONTINUE, <E>ND PROGRAM, <M>ENU";D$
  88. 1250 D$=CHR$(ASC(D$) AND 223)
  89. 1260 IF D$="C" THEN 1310
  90. 1270 IF D$="E" THEN 1320
  91. 1280 IF D$="M" THEN 250
  92. 1290 GOTO 1230
  93. 1310 K=K+BF:GOTO 390
  94. 1320 END
  95. 1350 U1=MG
  96. 1360 IF II%=1 THEN N%=0 ELSE N%=1
  97. 1370 IF MU<0 THEN T1$="TOTAL SOLAR":GOTO 1440
  98. 1380 IF MU>.0047 THEN T1$="ANNULAR SOLAR":GOTO 1440
  99. 1400 W=ATN(GY/SQR(ABS(-GY*GY+1)))
  100. 1410 OM=.00464*COS(W)
  101. 1420 IF MU<OM THEN T1$="ANNULAR/TOTAL SOLAR"
  102. 1430 IF MU>=OM THEN T1$="ANNULAR SOLAR"
  103. 1440 SC%=3:GOSUB 1760
  104. 1450 RETURN
  105. 1470 U1=MG
  106. 1480 T3=.9972+ABS(MU)
  107. 1490 IF (G1>.9972) AND (G1<T3) THEN GOSUB 1350:GOTO 1540
  108. 1500 IF G1>T3 THEN T1$="PARTIAL SOLAR"
  109. 1510 N%=0:SC%=3
  110. 1520 GOSUB 1760
  111. 1540 T1$=T1$+" (NC)"
  112. 1550 RETURN
  113. 1580 SC%=0
  114. 1590 IF UM<0 THEN 1700
  115. 1600 IF UM>=1 THEN T1$="TOTAL LUNAR" ELSE GOTO 1650
  116. 1610 N%=2
  117. 1620 U1=UM
  118. 1630 GOSUB 1760
  119. 1640 GOTO 1730
  120. 1650 T1$="PARTIAL LUNAR"
  121. 1660 N%=1
  122. 1670 U1=UM
  123. 1680 GOSUB 1760
  124. 1690 GOTO 1730
  125. 1700 T1$="PENUMBRAL LUNAR"
  126. 1710 U1=PM
  127. 1720 N%=0:GOSUB 1760
  128. 1730 RETURN
  129. 1760 FOR I%=0 TO N%
  130. 1770 SD(I%)=SQR(UR(I%+SC%)^2-GY^2)/NT
  131. 1780 NEXT I%
  132. 1800 FOR I%=0 TO N%
  133. 1810 GS%=4*I%
  134. 1820 TI%(GS%)=INT(((H2-SD(I%))-INT(H2-SD(I%)))*60)
  135. 1830 TI%(GS%+1)=INT(H2-SD(I%))
  136. 1840 TI%(GS%+2)=INT(((H2+SD(I%))-INT(H2+SD(I%)))*60)
  137. 1850 TI%(GS%+3)=INT(H2+SD(I%))
  138. 1860 NEXT I%
  139. 1880 FOR I%=1 TO 11 STEP 2
  140. 1890 IF TI%(I%)>=24 THEN TI%(I%)=TI%(I%)-24
  141. 1900 IF TI%(I%)<0 THEN TI%(I%)=TI%(I%)+24
  142. 1910 NEXT I%
  143. 1920 RETURN
  144. 1960 PRINT:PRINT:PRINT
  145. 1970 PRINT TAB(20)"ECLIPSE EVENT SUMMARY":PRINT
  146. 1980 PRINT USING "DATE OF ECLIPSE         ##/##/####";D1%,D2%,D3%
  147. 1990 PRINT "TYPE OF ECLIPSE          ";T1$
  148. 2000 PRINT "MOON IS AT               ";ND$;" NODE"
  149. 2010 IF LS$<>"L" THEN 2030
  150. 2020 PRINT "MOON PASSES              ";NS$;" OF EARTH'S SHADOW AXIS"
  151. 2030 PRINT USING "ECLIPSE MAGNITUDE        #.##";U1
  152. 2040 PRINT:PRINT TAB(20)"PHASE TIMES OF ECLIPSE":PRINT
  153. 2050 IF LS$="S" THEN GOSUB 2190 ELSE GOSUB 2080
  154. 2060 RETURN
  155. 2080 PRINT USING "MOON ENTERS PENUMBRA    ##:## UT ";TI%(1),TI%(0)
  156. 2090 IF N%=0 THEN GOSUB 2270:GOTO 2160
  157. 2100 PRINT USING "MOON ENTERS UMBRA       ##:## UT ";TI%(5),TI%(4)
  158. 2110 IF N%=1 THEN GOSUB 2270:GOTO 2150
  159. 2120 PRINT USING "TOTALITY BEGINS         ##:## UT ";TI%(9),TI%(8)
  160. 2130 GOSUB 2270
  161. 2140 PRINT USING "TOTALITY ENDS           ##:## UT ";TI%(11),TI%(10)
  162. 2150 PRINT USING "MOON LEAVES UMBRA       ##:## UT ";TI%(7),TI%(6)
  163. 2160 PRINT USING "MOON LEAVES PENUMBRA    ##:## UT ";TI%(3),TI%(2)
  164. 2170 RETURN
  165. 2190 PRINT USING "ECLIPSE BEGINS           ##:## UT ";TI%(1),TI%(0)
  166. 2200 IF N%=0 THEN GOSUB 2270:GOTO 2240
  167. 2210 PRINT USING "CENTRAL ECLIPSE BEGINS   ##:## UT ";TI%(5),TI%(4)
  168. 2220 GOSUB 2270
  169. 2230 PRINT USING "CENTRAL ECLIPSE ENDS     ##:## UT ";TI%(7),TI%(6)
  170. 2240 PRINT USING "ECLIPSE ENDS             ##:## UT ";TI%(3),TI%(2)
  171. 2250 RETURN
  172. 2270 PRINT USING "MAXIMUM ECLIPSE         ##:## UT ";TI%(13),TI%(14)
  173. 2280 RETURN
  174. 2300 PRINT
  175. 2310 PRINT USING "THERE IS NO ECLIPSE ON ##/##/####";D1%,D2%,D3%
  176. 2320 RETURN
  177. 2360 PRINT
  178. 2370 INPUT "ENTER THE YEAR  :";Y%
  179. 2380 INPUT "ENTER THE MONTH :";M%
  180. 2390 IF M%<1 OR M%>12 THEN 2380
  181. 2400 INPUT "ENTER THE DAY   :";D%
  182. 2410 IF (D%<1) OR (D%>31) THEN 2400
  183. 2420 IF (M%=2) AND (D%>29) THEN 2400
  184. 2430 INPUT "DO YOU WANT A <L>UNAR OR <S>OLAR ECLIPSE :";LS$
  185. 2440 LS$=CHR$(ASC(LS$) AND 223)
  186. 2450 IF (LS$<>"L") AND (LS$<>"S") THEN 2430
  187. 2460 INPUT "SEARCH <F>ORWARD OR <B>ACKWARD IN TIME    :";BF$
  188. 2470 BF$=CHR$(ASC(BF$) AND 223)
  189. 2480 IF BF$="F" OR BF$="f" THEN BF=1:GOTO 2510
  190. 2490 IF BF$="B" OR BF$="b" THEN BF=-1:GOTO 2510
  191. 2500 GOTO 2460
  192. 2510 RETURN
  193. 2550 LY%=0
  194. 2560 A2=Y%/4-INT(Y%/4)
  195. 2570 B2=Y%/100-INT(Y%/100)
  196. 2580 C2=Y%/400-INT(Y%/400)
  197. 2590 IF (A2=0) AND (B2<>0) THEN LY%=1
  198. 2600 IF C2=0 THEN LY%=1
  199. 2610 IF LY%=0 THEN D0%=INT((275*M%)/9)-2*INT((M%+9)/12)+D%-30 
  200. 2620 IF LY%=1 THEN D0%=INT((275*M%)/9)-INT((M%+9)/12)+D%-30
  201. 2630 RETURN
  202. 2670 JD=JD+.5
  203. 2680 IF JD>=1 THEN JW=JW+1:JD=JD-1
  204. 2690 Z=FIX(JW)
  205. 2700 F=JD
  206. 2710 AL%=FIX((Z-1867216.25#)/36524.25#)
  207. 2720 A=Z+1+AL%-FIX(AL%/4)
  208. 2730 IF Z<2.29916E+06 THEN A=Z
  209. 2740 B=A+1524
  210. 2750 C%=FIX((B-122.1)/365.25)
  211. 2760 DC=FIX(365.25*C%)
  212. 2770 E%=FIX((B-DC)/30.6001)
  213. 2780 DA=B-DC-FIX(30.6001*E%)+F
  214. 2790 IF E%<13.5 THEN E%=E%-1
  215. 2800 IF E%>13.5 THEN E%=E%-13
  216. 2810 IF E%>2.5 THEN C%=C%-4716
  217. 2820 IF E%<2.5 THEN C%=C%-4715
  218. 2830 D2%=FIX(DA)
  219. 2840 D1%=E%
  220. 2850 D3%=C%
  221. 2860 H2=(DA-FIX(DA))*24
  222. 2870 TI%(13)=INT(H2)
  223. 2880 TI%(14)=INT((H2-FIX(H2))*60)
  224. 2890 RETURN
  225.  
  226.  
  227.